home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio 2000 #1 / Ham Radio 2000.iso / ham2000 / packet / p_aa4re / bb212src / bblmc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1992-03-22  |  14.1 KB  |  365 lines
  1. (*===========================================================================*)
  2. (* List msg command                                                          *)
  3. (*     L      -- List messages newer than last L command                     *)
  4. (*     L0     -- Same as "L" but no pausing                                  *)
  5. (*     L n    -- List messages with number >= n                              *)
  6. (*     L_     -- List messages of type ' '                                   *)
  7. (*     LA     -- List messages of type 'A'                                   *)
  8. (*     LB     -- List messages of type 'B'                                   *)
  9. (*     LD > d -- List messages newer than date d.                            *)
  10. (*     LD < d -- List messages older than date d.                            *)
  11. (*     LF n   -- List forwarded messages greater than n                      *)
  12. (*     LH n   -- List held messages greater than n                           *)
  13. (*     LK n   -- List killed messages greater than n                         *)
  14. (*     LL n   -- List last n messages                                        *)
  15. (*     LM u   -- List messages of a specific user.  Default is current user  *)
  16. (*     LN n   -- List messages just sitting here unread greater than n       *)
  17. (*     LO n   -- List messages of with "old" attribute & number greater n    *)
  18. (*     LP     -- List messages of type 'P'                                   *)
  19. (*     LR u   -- List messages awaiting review                               *)
  20. (*     LS s   -- List messages with string in subject                        *)
  21. (*     LT     -- List NTS messages                                           *)
  22. (*     LU u   -- List unread messages to user u.  Current user is default    *)
  23. (*     LY n   -- List all read messages greater than n                       *)
  24. (*     L< u   -- List messages from a user u.                                *)
  25. (*     L> u   -- List messages to a user u.                                  *)
  26. (*     L@ b   -- List messages a mailbox b.                                  *)
  27. (*     L$ s   -- List messages with string in the BID                        *)
  28. (*     L+ n   -- List messages in forwarding progress with number grtr n     *)
  29. (*                                                                           *)
  30. (*   Copyright 1988, 1989, 1990, 1992 by H. Roy Engehausen.  All rights      *)
  31. (*   reserved.                                                               *)
  32. (*                                                                           *)
  33. (*===========================================================================*)
  34.  
  35. {$O+}
  36.  
  37. {$UNDEF   DEBUG_L0}
  38.  
  39. UNIT BBLMC;
  40.  
  41. INTERFACE
  42.  
  43.   USES
  44.     bbdummy,
  45.     bbmdata,
  46.     bbmess,
  47.     bbmisc,
  48.     bbmisc2,
  49.     bbmf,
  50.     bbmore,
  51.     bbrdata,
  52.     bbsdata,
  53.     bbsearch,
  54.     bbstr,
  55.     bbtime;
  56.  
  57. PROCEDURE list_msg_cmd(cmd_string : STRING);
  58.  
  59. IMPLEMENTATION
  60.  
  61. PROCEDURE list_msg_cmd(cmd_string : STRING);
  62.   VAR
  63.     code         : INTEGER;
  64.     command_l    : BYTE;    (* 0 = not "L", 1 = "L0", 2= "L" *)
  65.     l_msg_no     : LONGINT;
  66.     save_l       : LONGINT;
  67.     search_block : search_block_type;
  68.     word_count   : BYTE;
  69.  
  70.   BEGIN;
  71.  
  72.     save_l := 0;
  73.  
  74.     (*-----------------------------------------------------------------------*)
  75.     (* Parse command and execute right routine                               *)
  76.     (*-----------------------------------------------------------------------*)
  77.  
  78.     word_count := WORDS(cmd_string);
  79.  
  80.     IF cmd_string <> 'L0' THEN
  81.       command_l := 0
  82.     ELSE
  83.       BEGIN;
  84.         command_l  := 1;
  85.         cmd_string := 'L';
  86.       END;
  87.  
  88.     IF (LENGTH(cmd_string) <> 1) AND (cmd_string[2] <> ' ') THEN
  89.       BEGIN;
  90.         cmd_string := COPY(cmd_string, 2, 255);
  91.         set_search(cmd_string, @search_block);
  92.         IF active_tcb^.error_sw THEN
  93.           EXIT;
  94.       END
  95.     ELSE
  96.       BEGIN;
  97.  
  98.         (*-------------------------------------------------------------------*)
  99.         (* Too many words                                                    *)
  100.         (*-------------------------------------------------------------------*)
  101.  
  102.         IF word_count > 2 THEN
  103.           BEGIN;
  104.             send_message(message_err_wrd);
  105.             active_tcb^.error_sw := TRUE;
  106.             EXIT;
  107.           END;
  108.  
  109.         (*--------------------------------------------------------------*)
  110.         (* Init search block                                            *)
  111.         (*--------------------------------------------------------------*)
  112.  
  113.         FILLCHAR(search_block, SIZEOF(search_block), #0);
  114.         search_block.search_nok   := TRUE;
  115.         search_block.search_above := TRUE;
  116.  
  117.         (*--------------------------------------------------------------*)
  118.         (* Handle command operands                                      *)
  119.         (*--------------------------------------------------------------*)
  120.  
  121.         IF word_count > 1 THEN
  122.           BEGIN;
  123.  
  124.             (*---------------------------------------------------------*)
  125.             (* Operand present.  This is a message number              *)
  126.             (*---------------------------------------------------------*)
  127.  
  128.             VAL(subword(@cmd_string, 2, 1), l_msg_no, code);
  129.  
  130.             IF (code <> 0) OR (l_msg_no > 65535) OR (l_msg_no < 1) THEN
  131.               BEGIN;
  132.                 send_message(message_err_ivm);
  133.                 active_tcb^.error_sw := TRUE;
  134.                 EXIT;
  135.               END;
  136.  
  137.             search_block.search_msg_no := l_msg_no;
  138.             search_block.search_type   := ' ';
  139.  
  140.           END
  141.         ELSE
  142.           BEGIN;
  143.  
  144.             (*---------------------------------------------------------*)
  145.             (* No operand.  Search for messages later than last        *)
  146.             (* time we looked.                                         *)
  147.             (*---------------------------------------------------------*)
  148.  
  149.             IF (command_l = 0) AND (opt_block.max_l_shown > 0) THEN
  150.               command_l := 2;
  151.  
  152.             save_l                     := current_day_time;
  153.             search_block.search_dt     := active_tcb^.uid_data.user_l_time;
  154.             search_block.search_type   := 'D';
  155.  
  156.           END;
  157.  
  158.       END; (*----- End of 'L ' command handler ------------------------------*)
  159.  
  160.     (*-----------------------------------------------------------------------*)
  161.     (* Execute the search                                                    *)
  162.     (*-----------------------------------------------------------------------*)
  163.  
  164.     search_msg(@search_block);
  165.  
  166.     (*-----------------------------------------------------------------------*)
  167.     (* If nothing found, tell user and exit                                  *)
  168.     (*-----------------------------------------------------------------------*)
  169.  
  170.     IF search_block.search_last = NIL THEN
  171.       BEGIN;
  172.         send_message(message_lmc_nf);
  173.         EXIT;
  174.       END;
  175.  
  176.     (*-----------------------------------------------------------------------*)
  177.     (* "L" command limiter                                                   *)
  178.     (*-----------------------------------------------------------------------*)
  179.  
  180.     IF command_l = 2 THEN
  181.       BEGIN;
  182.         IF (active_tcb^.uid_data.user_scr_len < opt_block.max_l_shown)
  183.                             AND (active_tcb^.uid_data.user_scr_len <> 0) THEN
  184.           command_l := 1
  185.         ELSE
  186.           BEGIN;
  187.  
  188.             (*---------------------------------------------------------------*)
  189.             (* Count the messages                                            *)
  190.             (*---------------------------------------------------------------*)
  191.  
  192.             code := 0;
  193.  
  194.             REPEAT
  195.               INC(code);
  196.               search_msg(@search_block);
  197.             UNTIL search_block.search_last = NIL;
  198.  
  199.             (*---------------------------------------------------------------*)
  200.             (* If too many, handle it                                        *)
  201.             (*---------------------------------------------------------------*)
  202.  
  203.             IF code > opt_block.max_l_shown THEN
  204.               BEGIN;
  205.  
  206.                 (*-----------------------------------------------------------*)
  207.                 (* Send message                                              *)
  208.                 (*-----------------------------------------------------------*)
  209.  
  210.                 STR(code, cmd_string);
  211.                 set_dollar1_parm(@cmd_string);
  212.  
  213.                 send_message(message_l_pause);
  214.  
  215.                 (*-----------------------------------------------------------*)
  216.                 (* Get response                                              *)
  217.                 (*-----------------------------------------------------------*)
  218.  
  219.                 cmd_string := read_tnc_data_str;
  220.  
  221.                 strip_crlf(cmd_string);
  222.  
  223.                 (*-----------------------------------------------------------*)
  224.                 (* If nothing send back, quit                                *)
  225.                 (*-----------------------------------------------------------*)
  226.  
  227.                 IF LENGTH(cmd_string) = 0 THEN
  228.                   BEGIN;
  229.                     send_message(message_nodata_can);
  230.                     EXIT;
  231.                   END;
  232.  
  233.                 (*-----------------------------------------------------------*)
  234.                 (* If improper then quit                                     *)
  235.                 (*-----------------------------------------------------------*)
  236.  
  237.                 IF LENGTH(cmd_string) > 253 THEN
  238.                   BEGIN;
  239.                     send_message(message_err_wrd);
  240.                     active_tcb^.error_sw := TRUE;
  241.                     EXIT;
  242.                   END;
  243.  
  244.                 VAL(cmd_string, l_msg_no, code);
  245.  
  246.                 IF (code <> 0) OR (l_msg_no < 0) OR (l_msg_no > 32000) THEN
  247.                   BEGIN;
  248.                     send_message(message_bad_number);
  249.                     active_tcb^.error_sw := TRUE;
  250.                     EXIT;
  251.                   END;
  252.  
  253.                 IF l_msg_no = 0 THEN
  254.                   command_l := 1
  255.                 ELSE
  256.                   active_tcb^.out_force := TRUE;
  257.  
  258.                 {$IFDEF DEBUG_L0}
  259.                   WRITELN('max = ', l_msg_no);
  260.                 {$ENDIF}
  261.  
  262.               END;
  263.  
  264.             search_block.search_last := NIL;
  265.             search_msg(@search_block);
  266.  
  267.           END;
  268.  
  269.       END;
  270.  
  271.     (*-----------------------------------------------------------------------*)
  272.     (* Something found so first, send the header                             *)
  273.     (*-----------------------------------------------------------------------*)
  274.  
  275.     send_msg_header(-1);
  276.  
  277.     (*-----------------------------------------------------------------------*)
  278.     (* Now loop around send the message info, searching for next until done  *)
  279.     (*-----------------------------------------------------------------------*)
  280.  
  281.     WHILE search_block.search_last <> NIL DO
  282.       BEGIN;
  283.  
  284.         (*-------------------------------------------------------------------*)
  285.         (* Check for more                                                    *)
  286.         (*-------------------------------------------------------------------*)
  287.  
  288.         IF command_l = 2 THEN
  289.           BEGIN;
  290.             IF active_tcb^.out_line >= l_msg_no THEN
  291.               BEGIN;
  292.                 IF more_prompt THEN
  293.                   BEGIN;
  294.                     IF save_l <> 0 THEN
  295.                       active_tcb^.last_l_time := save_l;
  296.                     active_tcb^.out_force := FALSE;
  297.                     EXIT;
  298.                   END;
  299.                 more_clear;
  300.               END;
  301.           END
  302.         ELSE
  303.           BEGIN;
  304.             IF more_check THEN
  305.               BEGIN;
  306.                 IF save_l <> 0 THEN
  307.                   active_tcb^.last_l_time := save_l;
  308.                 EXIT;
  309.               END;
  310.           END;
  311.  
  312.         (*-------------------------------------------------------------------*)
  313.         (* Get the header string                                             *)
  314.         (*-------------------------------------------------------------------*)
  315.  
  316.         cmd_string := header_msg_block(search_block.search_last, -1) + cr;
  317.  
  318.         (*-------------------------------------------------------------------*)
  319.         (* If not a console then just put it out.  If it is a console, then  *)
  320.         (* send each line seperately                                         *)
  321.         (*-------------------------------------------------------------------*)
  322.  
  323.         IF NOT active_tcb^.tcb_console THEN
  324.           send_tnc_data_str(cmd_string)
  325.         ELSE
  326.           WHILE cmd_string <> '' DO
  327.             BEGIN;
  328.               code := POS(cr, cmd_string);
  329.               send_tnc_data_str(substr(cmd_string, 1, code));
  330.               IF code <> 0 THEN
  331.                 cmd_string := substr(cmd_string, code+1, 0)
  332.               ELSE
  333.                 cmd_string := '';
  334.             END;
  335.  
  336.         (*-------------------------------------------------------------------*)
  337.         (* If under review or in hold then put reason message                *)
  338.         (*-------------------------------------------------------------------*)
  339.  
  340.         IF ((search_block.search_last^.msg_i_mb.msg_flag AND
  341.                                                   (mf_hold OR mf_review) <> 0))
  342.                   AND (search_block.search_last^.msg_i_mb.msg_reason <> 0) THEN
  343.           send_message(search_block.search_last^.msg_i_mb.msg_reason);
  344.  
  345.         (*-------------------------------------------------------------------*)
  346.         (* Search for next hit                                               *)
  347.         (*-------------------------------------------------------------------*)
  348.  
  349.         search_msg(@search_block);
  350.  
  351.       END;
  352.  
  353.     active_tcb^.out_force := FALSE;
  354.  
  355.     (*-----------------------------------------------------------------------*)
  356.     (* If this was a command to list since last l command, update the info   *)
  357.     (*-----------------------------------------------------------------------*)
  358.  
  359.     IF save_l <> 0 THEN
  360.       active_tcb^.last_l_time := save_l;
  361.  
  362.   END;
  363.  
  364. END.
  365.